Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

175

Games Picked

270

Number of predictions

68

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 Baltimore Ravens Pittsburgh Steelers No 20 0.2941
2 Houston Texans Houston Texans Yes 44 0.6471
3 New Orleans Saints New Orleans Saints Yes 57 0.8382
4 Cleveland Browns Cincinnati Bengals No 20 0.2941
5 Jacksonville Jaguars Tennessee Titans No 7 0.1029
6 Detroit Lions Detroit Lions Yes 63 0.9265
7 New England Patriots New York Jets No 28 0.4118
8 Tampa Bay Buccaneers Tampa Bay Buccaneers Yes 66 0.9706
9 Green Bay Packers Green Bay Packers Yes 47 0.6912
10 Dallas Cowboys Dallas Cowboys Yes 66 0.9706
11 Las Vegas Raiders Las Vegas Raiders Yes 41 0.6029
12 Kansas City Chiefs Kansas City Chiefs Yes 57 0.8382
13 San Francisco 49ers Los Angeles Rams No 17 0.2500
14 Philadelphia Eagles New York Giants No 4 0.0588
15 Seattle Seahawks Seattle Seahawks Yes 55 0.8088
16 Buffalo Bills Buffalo Bills Yes 35 0.5147

Individual Predictions

row

Individual Table

Individual Results
Week 18
Name Weekly # Correct Percent Weeks Picked Season Percent Adj Season Percent Season Trend
Week 1 Week 2 Week 3 Week 4 Week 5 Week 6 Week 7 Week 8 Week 9 Week 10 Week 11 Week 12 Week 13 Week 14 Week 15 Week 16 Week 17 Week 18
John Plaster 8 12 8 10 NA NA 6 9 7 10 9 7 8 8 10 10 12 13 0.8125 16 0.6100 0.5422
Jonathon Leslein 9 9 9 9 7 11 5 9 8 10 10 NA 9 5 10 9 10 13 0.8125 17 0.5984 0.5652
Stephen Woolwine 8 13 9 NA NA 9 NA 11 11 NA 10 12 9 NA NA 9 NA 12 0.7500 11 0.6807 0.4160
Ryan Wiggins 8 11 11 12 7 11 5 11 10 8 10 10 7 6 12 10 NA 12 0.7500 17 0.6339 0.5987
Daniel Halse 8 9 10 NA NA NA 7 11 NA 7 7 NA 8 NA 11 10 13 12 0.7500 12 0.6278 0.4185
WAYNE SCHOFIELD 12 9 7 NA 8 NA 5 10 7 NA 10 NA 8 8 12 NA NA 12 0.7500 12 0.6102 0.4068
Trevor MACGAVIN 6 10 8 NA 6 7 4 NA 6 6 9 13 7 9 8 9 10 12 0.7500 16 0.5462 0.4855
Derrick Elam NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 11 0.6875 1 0.6875 0.0382
Jason Schattel 7 10 9 11 9 10 3 13 12 9 10 12 9 6 10 11 NA 11 0.6875 17 0.6378 0.6024
Cheryl Brown 10 12 11 9 6 9 6 10 8 9 8 12 8 8 11 11 11 11 0.6875 18 0.6296 0.6296
Stephen Bush 7 10 10 9 7 10 6 12 NA 5 10 11 8 8 11 9 14 11 0.6875 17 0.6172 0.5829
James Small 8 8 13 9 8 10 8 10 12 6 10 9 5 7 9 8 11 11 0.6875 18 0.6000 0.6000
William Schouviller 10 9 11 10 8 9 NA 13 10 9 9 10 10 6 11 10 12 10 0.6250 17 0.6498 0.6137
Anthony Bloss 8 10 11 12 10 10 5 9 9 8 9 11 10 6 11 9 13 10 0.6250 18 0.6333 0.6333
Cody Koerwitz 7 9 11 12 7 10 6 NA 9 9 10 10 9 6 13 NA NA 10 0.6250 15 0.6216 0.5180
Brian Patterson 10 10 8 11 7 11 5 10 10 8 11 12 7 6 9 8 13 10 0.6250 18 0.6148 0.6148
Shaun Dahl 8 8 10 10 7 9 5 13 9 8 NA NA 8 8 13 11 NA 10 0.6250 15 0.6116 0.5097
Eric Hahn 9 13 7 9 8 10 6 9 10 6 11 12 9 6 10 8 12 10 0.6250 18 0.6111 0.6111
James Tierney 9 10 NA 10 10 12 7 10 8 9 9 10 8 8 7 11 8 10 0.6250 17 0.6094 0.5755
Matthew Schultz 8 NA 10 8 9 9 6 10 11 8 9 12 5 NA NA NA 10 10 0.6250 14 0.6039 0.4697
Bunnaro Sun 9 10 9 8 9 9 6 9 11 8 10 10 8 5 12 NA 9 10 0.6250 17 0.5984 0.5652
Amy Asberry 8 9 10 9 9 8 5 10 6 9 7 10 9 7 12 11 12 10 0.6250 18 0.5963 0.5963
Yiming Hu 9 10 8 12 7 9 6 9 10 8 10 NA 7 6 9 9 12 10 0.6250 17 0.5945 0.5615
Daniel Baller 6 12 11 9 8 9 3 10 8 9 10 9 8 9 9 9 9 10 0.6250 18 0.5852 0.5852
Anthony Brinson 10 11 8 6 10 9 8 10 9 7 8 11 9 5 9 8 7 10 0.6250 18 0.5741 0.5741
Justin Crick 11 11 11 13 8 11 4 11 11 8 9 12 9 8 11 9 11 9 0.5625 18 0.6556 0.6556
George Sweet 9 11 10 12 7 10 10 NA 11 8 10 13 9 8 8 8 11 9 0.5625 17 0.6457 0.6098
Ramar Williams NA 11 11 9 8 8 6 12 NA 8 NA 13 9 6 11 NA 13 9 0.5625 14 0.6381 0.4963
Chris Papageorge 11 11 11 10 8 9 5 11 12 8 8 NA 10 NA 10 9 NA 9 0.5625 15 0.6368 0.5307
Antonio Mitchell 10 12 NA 11 10 10 5 12 9 NA 10 12 NA 6 8 10 10 9 0.5625 15 0.6288 0.5240
Montee Brown 7 NA NA 9 9 11 6 12 11 8 10 12 8 6 11 10 10 9 0.5625 16 0.6208 0.5518
Gabriel Quinones 9 11 12 12 6 9 6 11 NA 8 9 NA 9 8 9 10 NA 9 0.5625 15 0.6161 0.5134
Patrick Tynan 8 8 10 11 7 NA 5 11 10 7 11 13 8 5 12 10 12 9 0.5625 17 0.6157 0.5815
DAVID PLATE 8 NA 8 9 8 10 5 9 11 8 9 12 NA 7 13 NA 11 9 0.5625 15 0.6089 0.5074
PABLO BURGOSRAMOS 9 11 10 12 7 12 6 8 9 7 10 NA 8 3 12 10 11 9 0.5625 17 0.6063 0.5726
MICHAEL BRANSON 8 11 10 12 9 10 4 11 10 7 8 NA 10 9 8 8 NA 9 0.5625 16 0.6050 0.5378
Aubrey Conn 9 12 8 11 9 9 4 11 11 8 7 12 8 5 9 10 NA 9 0.5625 17 0.5984 0.5652
Walter Archambo 7 10 10 11 7 9 5 9 12 NA 8 11 9 5 10 10 11 9 0.5625 17 0.5977 0.5645
Earl Dixon 9 11 8 12 5 NA 7 8 9 8 9 12 8 6 11 10 NA 9 0.5625 16 0.5941 0.5281
Brian Hollmann 8 13 8 9 8 9 6 13 8 8 8 12 6 5 11 10 8 9 0.5625 18 0.5889 0.5889
Charlene Redmer 9 9 NA 9 9 11 NA 10 8 7 8 NA 6 NA NA 10 NA 9 0.5625 12 0.5833 0.3889
Kevin Kehoe 9 10 11 12 7 8 6 10 7 8 8 8 NA 6 9 8 12 9 0.5625 17 0.5759 0.5439
Thomas Brenstuhl 10 NA 8 8 8 9 5 9 11 6 11 NA 8 5 11 NA NA 9 0.5625 14 0.5728 0.4455
Khalil Ibrahim 7 12 9 NA 7 10 6 10 9 5 7 11 5 7 11 11 NA 9 0.5625 16 0.5714 0.5079
Daniel Kuehl 6 10 8 11 7 9 7 12 7 6 10 11 8 6 9 9 NA 9 0.5625 17 0.5709 0.5392
Kevin Green 9 12 9 9 8 9 7 NA NA 6 10 11 4 7 6 8 13 9 0.5625 16 0.5708 0.5074
Melissa Printup 8 NA 8 7 10 7 6 NA NA 5 9 9 NA 9 7 8 8 9 0.5625 14 0.5213 0.4055
Keithon Corpening 8 NA NA NA NA NA NA 11 12 9 8 10 6 8 12 9 10 8 0.5000 12 0.6099 0.4066
Ryan Cvik 11 11 9 13 6 10 8 8 6 8 10 10 8 9 9 9 11 8 0.5000 18 0.6074 0.6074
Paul Presti 9 10 12 9 8 9 5 8 NA 9 9 NA 8 10 11 9 NA 8 0.5000 15 0.5982 0.4985
Paul Shim 10 9 10 11 7 9 4 10 10 8 11 10 8 8 9 8 11 8 0.5000 18 0.5963 0.5963
Brandon Parks 8 8 NA NA 9 9 5 9 9 9 8 10 10 10 9 9 NA 8 0.5000 15 0.5804 0.4837
Kristen White 7 13 8 11 6 7 7 10 8 6 10 7 8 7 8 NA 13 8 0.5000 17 0.5669 0.5354
Robert Lynch 9 9 6 10 10 6 4 9 10 5 9 8 7 6 12 10 11 8 0.5000 18 0.5519 0.5519
Justin Thrift 9 8 9 8 9 7 5 11 7 6 10 NA 7 9 8 10 NA 8 0.5000 16 0.5504 0.4892
THOMAS MCCOY 8 10 9 7 8 9 7 11 7 7 NA 10 5 8 NA 9 9 8 0.5000 16 0.5500 0.4889
Cherylynn Vidal 10 9 9 12 9 7 4 6 9 7 NA 9 6 5 9 10 NA 8 0.5000 16 0.5375 0.4778
Robert Martin 10 9 6 NA 9 9 6 9 NA 5 9 9 6 8 9 7 NA 8 0.5000 15 0.5312 0.4427
David Spielman 8 NA 11 NA NA NA 3 NA 7 8 9 NA NA NA NA 8 NA 8 0.5000 8 0.5299 0.2355
Craig Webster NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 8 0.5000 1 0.5000 0.0278
Karen Coleman 7 10 NA 10 8 9 4 9 13 11 9 12 8 6 10 8 14 7 0.4375 17 0.6055 0.5719
Terry Hardison 10 10 9 11 7 9 4 11 9 10 9 11 8 7 11 8 11 7 0.4375 18 0.6000 0.6000
Shawn Carden 9 12 6 9 8 9 5 10 9 8 9 12 7 6 10 11 10 7 0.4375 18 0.5815 0.5815
Daniel Major 8 13 6 7 8 11 7 11 NA NA 9 NA 7 NA NA NA NA 7 0.4375 11 0.5767 0.3524
Manuel Vargas 10 9 11 12 7 10 6 12 5 5 7 8 9 7 10 NA 11 7 0.4375 17 0.5748 0.5429
Ryan Shipley 3 8 7 6 6 7 5 10 9 6 9 NA 5 6 11 8 9 7 0.4375 17 0.4803 0.4536
George Mancini 7 12 10 10 9 10 6 NA 7 9 9 11 5 7 NA 10 7 6 0.3750 16 0.5672 0.5042
Rafael Torres 6 8 12 11 NA NA 6 NA 9 5 10 8 5 6 11 6 12 6 0.3750 15 0.5378 0.4482
Michael Edmunds 10 12 10 10 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 4 0.6774 0.1505
Kevin O'NEILL 8 11 11 13 7 NA NA 10 NA NA NA NA NA NA NA NA NA NA 0.0000 6 0.6522 0.2174
Shelly Bailey 9 10 NA 10 8 11 6 NA 13 7 9 13 NA NA NA NA NA NA 0.0000 10 0.6486 0.3603
Sarah Sweet 9 12 12 9 8 NA 6 11 11 10 8 9 6 NA NA NA NA NA 0.0000 12 0.6307 0.4205
Carlos Caceres 10 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.6250 0.0347
Vincent Scannelli 11 11 8 11 7 NA 5 9 12 10 10 NA 8 6 NA 11 NA NA 0.0000 13 0.6230 0.4499
Bradley Hobson 8 10 11 12 8 11 4 NA 8 9 9 12 NA 6 10 NA 11 NA 0.0000 14 0.6172 0.4800
Donald Park 8 12 7 9 NA NA 6 10 11 NA 9 NA NA NA NA NA NA NA 0.0000 8 0.6050 0.2689
Michael Moss 10 NA 11 13 7 9 4 10 9 8 9 10 8 5 10 11 10 NA 0.0000 16 0.6050 0.5378
Ronald Schmidt 11 13 11 8 8 11 5 9 8 8 7 NA 7 7 9 11 10 NA 0.0000 16 0.6008 0.5340
James Blejski 8 11 10 14 NA 9 7 12 7 6 9 9 9 6 7 9 NA NA 0.0000 15 0.5938 0.4948
Pamela AUGUSTINE 11 13 6 9 6 9 5 10 9 NA 10 11 8 6 11 9 NA NA 0.0000 15 0.5938 0.4948
Robert Gelo 6 9 10 10 9 11 5 11 6 9 9 10 8 6 11 NA NA NA 0.0000 15 0.5856 0.4880
William Sherman 8 11 10 10 6 NA 5 NA 9 NA 9 NA NA NA NA NA NA NA 0.0000 8 0.5812 0.2583
Steven Curtis NA NA 11 7 8 10 6 7 8 7 7 11 7 8 11 11 NA NA 0.0000 14 0.5777 0.4493
Rahmatullah Sharifi 11 9 8 11 8 8 5 NA NA NA NA NA NA NA NA NA NA NA 0.0000 7 0.5769 0.2244
Gregory Flint 6 11 NA 11 8 10 NA NA 9 5 8 NA 9 5 10 NA 10 NA 0.0000 12 0.5698 0.3799
Steven Webster 8 8 6 8 9 8 6 10 10 8 10 NA 7 6 12 NA NA NA 0.0000 14 0.5631 0.4380
Jamal Willis 8 10 NA NA NA NA NA 9 NA NA NA NA NA NA NA NA NA NA 0.0000 3 0.5625 0.0938
Jason James 9 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.5625 0.0312
TYREE BUNDY 8 8 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 11 NA 0.0000 3 0.5625 0.0938
Michael Beck 9 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.5625 0.0312
DERRICK ELAM 6 9 11 10 10 7 NA 5 7 7 6 NA 7 9 NA 12 NA NA 0.0000 13 0.5492 0.3966
Alexander Santillan 5 NA 8 9 5 11 6 11 8 9 7 9 8 8 NA NA NA NA 0.0000 13 0.5474 0.3953
Min Choi 6 7 9 11 7 10 5 13 7 5 NA NA NA NA NA NA NA NA 0.0000 10 0.5405 0.3003
Derrick Zantt 11 6 7 NA 6 9 6 11 NA NA NA NA NA NA NA NA NA NA 0.0000 7 0.5385 0.2094
Rodney Cathcart NA NA NA NA NA NA NA NA NA NA NA NA 7 NA NA NA NA NA 0.0000 1 0.5385 0.0299
Edward Ford 6 8 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 2 0.4375 0.0486

Individual Plots

Season Leaderboard

Season Leaderboard (Season Percent)
Week 18
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Derrick Elam 0 1 0.6875 0.0382
2 Stephen Woolwine 1 11 0.6807 0.4160
3 Michael Edmunds 0 4 0.6774 0.1505
4 Justin Crick 0 18 0.6556 0.6556
5 Kevin O'NEILL 0 6 0.6522 0.2174
6 William Schouviller 2 17 0.6498 0.6137
7 Shelly Bailey 2 10 0.6486 0.3603
8 George Sweet 2 17 0.6457 0.6098
9 Ramar Williams 1 14 0.6381 0.4963
10 Jason Schattel 1 17 0.6378 0.6024
11 Chris Papageorge 1 15 0.6368 0.5307
12 Ryan Wiggins 0 17 0.6339 0.5987
13 Anthony Bloss 2 18 0.6333 0.6333
14 Sarah Sweet 0 12 0.6307 0.4205
15 Cheryl Brown 0 18 0.6296 0.6296
16 Antonio Mitchell 1 15 0.6288 0.5240
17 Daniel Halse 0 12 0.6278 0.4185
18 Carlos Caceres 0 1 0.6250 0.0347
19 Vincent Scannelli 0 13 0.6230 0.4499
20 Cody Koerwitz 1 15 0.6216 0.5180
21 Montee Brown 0 16 0.6208 0.5518
22 Bradley Hobson 0 14 0.6172 0.4800
22 Stephen Bush 1 17 0.6172 0.5829
24 Gabriel Quinones 0 15 0.6161 0.5134
25 Patrick Tynan 2 17 0.6157 0.5815
26 Brian Patterson 1 18 0.6148 0.6148
27 Shaun Dahl 2 15 0.6116 0.5097
28 Eric Hahn 2 18 0.6111 0.6111
29 WAYNE SCHOFIELD 1 12 0.6102 0.4068
30 John Plaster 1 16 0.6100 0.5422
31 Keithon Corpening 0 12 0.6099 0.4066
32 James Tierney 2 17 0.6094 0.5755
33 DAVID PLATE 1 15 0.6089 0.5074
34 Ryan Cvik 0 18 0.6074 0.6074
35 PABLO BURGOSRAMOS 1 17 0.6063 0.5726
36 Karen Coleman 3 17 0.6055 0.5719
37 Donald Park 0 8 0.6050 0.2689
37 MICHAEL BRANSON 1 16 0.6050 0.5378
37 Michael Moss 0 16 0.6050 0.5378
40 Matthew Schultz 0 14 0.6039 0.4697
41 Ronald Schmidt 1 16 0.6008 0.5340
42 James Small 1 18 0.6000 0.6000
42 Terry Hardison 0 18 0.6000 0.6000
44 Aubrey Conn 0 17 0.5984 0.5652
44 Bunnaro Sun 0 17 0.5984 0.5652
44 Jonathon Leslein 1 17 0.5984 0.5652
47 Paul Presti 1 15 0.5982 0.4985
48 Walter Archambo 0 17 0.5977 0.5645
49 Amy Asberry 0 18 0.5963 0.5963
49 Paul Shim 1 18 0.5963 0.5963
51 Yiming Hu 0 17 0.5945 0.5615
52 Earl Dixon 0 16 0.5941 0.5281
53 James Blejski 1 15 0.5938 0.4948
53 Pamela AUGUSTINE 1 15 0.5938 0.4948
55 Brian Hollmann 2 18 0.5889 0.5889
56 Robert Gelo 0 15 0.5856 0.4880
57 Daniel Baller 0 18 0.5852 0.5852
58 Charlene Redmer 0 12 0.5833 0.3889
59 Shawn Carden 0 18 0.5815 0.5815
60 William Sherman 0 8 0.5812 0.2583
61 Brandon Parks 2 15 0.5804 0.4837
62 Steven Curtis 0 14 0.5777 0.4493
63 Rahmatullah Sharifi 0 7 0.5769 0.2244
64 Daniel Major 1 11 0.5767 0.3524
65 Kevin Kehoe 0 17 0.5759 0.5439
66 Manuel Vargas 0 17 0.5748 0.5429
67 Anthony Brinson 1 18 0.5741 0.5741
68 Thomas Brenstuhl 1 14 0.5728 0.4455
69 Khalil Ibrahim 0 16 0.5714 0.5079
70 Daniel Kuehl 0 17 0.5709 0.5392
71 Kevin Green 0 16 0.5708 0.5074
72 Gregory Flint 0 12 0.5698 0.3799
73 George Mancini 0 16 0.5672 0.5042
74 Kristen White 1 17 0.5669 0.5354
75 Steven Webster 0 14 0.5631 0.4380
76 Jamal Willis 0 3 0.5625 0.0938
76 Jason James 0 1 0.5625 0.0312
76 Michael Beck 0 1 0.5625 0.0312
76 TYREE BUNDY 0 3 0.5625 0.0938
80 Robert Lynch 1 18 0.5519 0.5519
81 Justin Thrift 0 16 0.5504 0.4892
82 THOMAS MCCOY 0 16 0.5500 0.4889
83 DERRICK ELAM 2 13 0.5492 0.3966
84 Alexander Santillan 0 13 0.5474 0.3953
85 Trevor MACGAVIN 1 16 0.5462 0.4855
86 Min Choi 1 10 0.5405 0.3003
87 Derrick Zantt 0 7 0.5385 0.2094
87 Rodney Cathcart 0 1 0.5385 0.0299
89 Rafael Torres 0 15 0.5378 0.4482
90 Cherylynn Vidal 0 16 0.5375 0.4778
91 Robert Martin 0 15 0.5312 0.4427
92 David Spielman 0 8 0.5299 0.2355
93 Melissa Printup 1 14 0.5213 0.4055
94 Craig Webster 0 1 0.5000 0.0278
95 Ryan Shipley 0 17 0.4803 0.4536
96 Edward Ford 0 2 0.4375 0.0486

Adjusted Season Leaderboard

Season Leaderboard (Adjusted Season Percent)
Week 18
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Justin Crick 0 18 0.6556 0.6556
2 Anthony Bloss 2 18 0.6333 0.6333
3 Cheryl Brown 0 18 0.6296 0.6296
4 Brian Patterson 1 18 0.6148 0.6148
5 William Schouviller 2 17 0.6498 0.6137
6 Eric Hahn 2 18 0.6111 0.6111
7 George Sweet 2 17 0.6457 0.6098
8 Ryan Cvik 0 18 0.6074 0.6074
9 Jason Schattel 1 17 0.6378 0.6024
10 James Small 1 18 0.6000 0.6000
10 Terry Hardison 0 18 0.6000 0.6000
12 Ryan Wiggins 0 17 0.6339 0.5987
13 Amy Asberry 0 18 0.5963 0.5963
13 Paul Shim 1 18 0.5963 0.5963
15 Brian Hollmann 2 18 0.5889 0.5889
16 Daniel Baller 0 18 0.5852 0.5852
17 Stephen Bush 1 17 0.6172 0.5829
18 Patrick Tynan 2 17 0.6157 0.5815
18 Shawn Carden 0 18 0.5815 0.5815
20 James Tierney 2 17 0.6094 0.5755
21 Anthony Brinson 1 18 0.5741 0.5741
22 PABLO BURGOSRAMOS 1 17 0.6063 0.5726
23 Karen Coleman 3 17 0.6055 0.5719
24 Aubrey Conn 0 17 0.5984 0.5652
24 Bunnaro Sun 0 17 0.5984 0.5652
24 Jonathon Leslein 1 17 0.5984 0.5652
27 Walter Archambo 0 17 0.5977 0.5645
28 Yiming Hu 0 17 0.5945 0.5615
29 Robert Lynch 1 18 0.5519 0.5519
30 Montee Brown 0 16 0.6208 0.5518
31 Kevin Kehoe 0 17 0.5759 0.5439
32 Manuel Vargas 0 17 0.5748 0.5429
33 John Plaster 1 16 0.6100 0.5422
34 Daniel Kuehl 0 17 0.5709 0.5392
35 MICHAEL BRANSON 1 16 0.6050 0.5378
35 Michael Moss 0 16 0.6050 0.5378
37 Kristen White 1 17 0.5669 0.5354
38 Ronald Schmidt 1 16 0.6008 0.5340
39 Chris Papageorge 1 15 0.6368 0.5307
40 Earl Dixon 0 16 0.5941 0.5281
41 Antonio Mitchell 1 15 0.6288 0.5240
42 Cody Koerwitz 1 15 0.6216 0.5180
43 Gabriel Quinones 0 15 0.6161 0.5134
44 Shaun Dahl 2 15 0.6116 0.5097
45 Khalil Ibrahim 0 16 0.5714 0.5079
46 DAVID PLATE 1 15 0.6089 0.5074
46 Kevin Green 0 16 0.5708 0.5074
48 George Mancini 0 16 0.5672 0.5042
49 Paul Presti 1 15 0.5982 0.4985
50 Ramar Williams 1 14 0.6381 0.4963
51 James Blejski 1 15 0.5938 0.4948
51 Pamela AUGUSTINE 1 15 0.5938 0.4948
53 Justin Thrift 0 16 0.5504 0.4892
54 THOMAS MCCOY 0 16 0.5500 0.4889
55 Robert Gelo 0 15 0.5856 0.4880
56 Trevor MACGAVIN 1 16 0.5462 0.4855
57 Brandon Parks 2 15 0.5804 0.4837
58 Bradley Hobson 0 14 0.6172 0.4800
59 Cherylynn Vidal 0 16 0.5375 0.4778
60 Matthew Schultz 0 14 0.6039 0.4697
61 Ryan Shipley 0 17 0.4803 0.4536
62 Vincent Scannelli 0 13 0.6230 0.4499
63 Steven Curtis 0 14 0.5777 0.4493
64 Rafael Torres 0 15 0.5378 0.4482
65 Thomas Brenstuhl 1 14 0.5728 0.4455
66 Robert Martin 0 15 0.5312 0.4427
67 Steven Webster 0 14 0.5631 0.4380
68 Sarah Sweet 0 12 0.6307 0.4205
69 Daniel Halse 0 12 0.6278 0.4185
70 Stephen Woolwine 1 11 0.6807 0.4160
71 WAYNE SCHOFIELD 1 12 0.6102 0.4068
72 Keithon Corpening 0 12 0.6099 0.4066
73 Melissa Printup 1 14 0.5213 0.4055
74 DERRICK ELAM 2 13 0.5492 0.3966
75 Alexander Santillan 0 13 0.5474 0.3953
76 Charlene Redmer 0 12 0.5833 0.3889
77 Gregory Flint 0 12 0.5698 0.3799
78 Shelly Bailey 2 10 0.6486 0.3603
79 Daniel Major 1 11 0.5767 0.3524
80 Min Choi 1 10 0.5405 0.3003
81 Donald Park 0 8 0.6050 0.2689
82 William Sherman 0 8 0.5812 0.2583
83 David Spielman 0 8 0.5299 0.2355
84 Rahmatullah Sharifi 0 7 0.5769 0.2244
85 Kevin O'NEILL 0 6 0.6522 0.2174
86 Derrick Zantt 0 7 0.5385 0.2094
87 Michael Edmunds 0 4 0.6774 0.1505
88 Jamal Willis 0 3 0.5625 0.0938
88 TYREE BUNDY 0 3 0.5625 0.0938
90 Edward Ford 0 2 0.4375 0.0486
91 Derrick Elam 0 1 0.6875 0.0382
92 Carlos Caceres 0 1 0.6250 0.0347
93 Jason James 0 1 0.5625 0.0312
93 Michael Beck 0 1 0.5625 0.0312
95 Rodney Cathcart 0 1 0.5385 0.0299
96 Craig Webster 0 1 0.5000 0.0278

Data

---
title: "2023 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    orientation: rows
    vertical_layout: fill
    social: ["menu"]
    source_code: embed
    navbar:
      - { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer"  }
---


```{r setup, include=FALSE}
#    source_code: embed
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")

thematic::thematic_rmd(font = "auto")

```

```{r Reading in our picks files, include=FALSE}
current_week = 18 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2023 NFL Week 1.csv")
week_2 = read_csv("./CSV_Data_Files/2023 NFL Week 2.csv")
week_3 = read_csv("./CSV_Data_Files/2023 NFL Week 3.csv")
week_4 = read_csv("./CSV_Data_Files/2023 NFL Week 4.csv")
week_5 = read_csv("./CSV_Data_Files/2023 NFL Week 5.csv")
week_6 = read_csv("./CSV_Data_Files/2023 NFL Week 6.csv")
week_7 = read_csv("./CSV_Data_Files/2023 NFL Week 7.csv")
week_8 = read_csv("./CSV_Data_Files/2023 NFL Week 8.csv")
week_9 = read_csv("./CSV_Data_Files/2023 NFL Week 9.csv")
week_10 = read_csv("./CSV_Data_Files/2023 NFL Week 10.csv")
week_11 = read_csv("./CSV_Data_Files/2023 NFL Week 11.csv")
week_12 = read_csv("./CSV_Data_Files/2023 NFL Week 12.csv")
week_13 = read_csv("./CSV_Data_Files/2023 NFL Week 13.csv")
week_14 = read_csv("./CSV_Data_Files/2023 NFL Week 14.csv")
week_15 = read_csv("./CSV_Data_Files/2023 NFL Week 15.csv")
week_16 = read_csv("./CSV_Data_Files/2023 NFL Week 16.csv")
week_17 = read_csv("./CSV_Data_Files/2023 NFL Week 17.csv")
week_18 = read_csv("./CSV_Data_Files/2023 NFL Week 18.csv")
# week_19 = read_csv("./CSV_Data_Files/2023 NFL Wild Card.csv")
# week_20 = read_csv("./CSV_Data_Files/2023 NFL Divisional Round.csv")
# week_21 = read_csv("./CSV_Data_Files/2023 NFL Conference Round.csv")
# week_22 = read_csv("./CSV_Data_Files/2023 NFL Super Bowl.csv")

#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv")) 

#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>% 
  mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))

#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))

#Odds not working for the 2023 season.  Need to fix scrape code for next year.
#Reading in the moneyline odds for each team and cleaning the team names
# odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
# odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
# odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
# odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
# odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
# odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
# odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
# odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
# odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
# odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
# odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
# odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
# odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
# odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
# odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
# odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
# odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
# odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
# odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
# odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
# odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
# odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))

####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3, week_4, week_5, week_6, week_7, week_8, week_9, week_10, week_11, week_12, week_13, week_14, week_15, week_16, week_17 , week_18) #, week_19, week_20, week_21) #add in the additional weeks
# odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7, odds_wk8,
#              odds_wk9, odds_wk10, odds_wk11, odds_wk12) #add in the additional weeks
####################END OF UPDATE##############################

weeks = as.list(seq(1:current_week)) #creating a list of each week number
```

```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
# cl_odds = odds_cleaning(odds)

#Cleaning scores data
Scores = cleaning2(Scores)

#creating a list of winners for each week
winners = map(weeks, weekly_winners)

#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])  

#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```

```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)

#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```


```{r Displaying Group Results, echo=FALSE}
#Displaying the group results

inst_group_table = results[[length(results)]] %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    #subtitle = md(glue("Week {length(results)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="No"
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="Yes"
    )) %>% 
  tab_options(
    data_row.padding = px(3),
    container.height = "100%"
   )
```

```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage     

#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)  

#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)

#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)

#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)

#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)

#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))

#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))

#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```

```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>% 
  rename(`Win Percentage` = ".") %>% 
  add_column(Week = unlist(weeks))
```

```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>% 
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
  geom_point()+
  geom_path(aes(x = Week))+
  ylim(c(0, 1)) +
  xlab("NFL Week") + 
  ylab("Correct Percentage")+
  ggtitle("Weekly Group Correct Percentage")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5, size = 18))
```

```{r beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```

```{r beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```

```{r beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_total = map(espn_weekly_percent, experts_tot)
```

```{r beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_season_total = map(espn_season_percent, experts_tot)
```

```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)

#Combining each week into one dataframe and calculating percentage Correct for this week.  
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>% 
  mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4)) 

#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))

#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = ifelse(is.na(a[i,j])==T,0,1)
    tot_week[i] = sum(help)
  }
}

#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
    tot_picks[i] = sum(help)
  }
}

#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
  tot_correct[i] = sum(a[i,], na.rm = T)
}

#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
  add_column(tot_correct)%>%
  add_column(tot_picks)%>%
  mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
  mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
  select(-tot_correct, -tot_picks) %>%
  arrange(desc(Percent), desc(`Season Percent`)) %>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```


```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")

weekly_indiv_percent_plot = weekly_indiv_percent %>% 
  pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>% 
  mutate(Week = as.factor(Week))

levels = NULL
for(i in 1:length(weeks)){
  levels[i] = glue("Week {i}")  
}

weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
  mutate(Week = factor(Week, levels))
```

```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
  plot_object = 
    ggplot(data = df,
           aes(x = as.factor(Week), y=Percent, group = 1))+
    geom_path(size = 7)+
    scale_y_continuous(limits = c(0,1))+
    theme_void()+
    theme(legend.position = "none")
  return(plot_object)
}

sparklines = 
  weekly_indiv_percent_plot %>% 
  group_by(Name) %>% 
  nest() %>% 
  mutate(plot = map2(Name, data, plot_group)) %>% 
  select(-data)
  
indiv_disp_2 = indiv_disp %>% 
  inner_join(sparklines, by = "Name") %>% 
  mutate(`Season Trend` = NA)
```

```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Individual Results"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent>.5
    )) %>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(c(plot))

indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```

```{r Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```

```{r Printing Adj Season Leaderboard, echo=FALSE}
# Printing the Adj Season Leaderboard
  
adj_season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Adjusted Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))

```


```{r instructor formattable, echo=FALSE}
improvement_formatter <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold", 
              color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
             x ~ icontext(ifelse(x == max(x), "star", ""), x))

indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))

indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3, 
                                align = c("l", rep("c", NROW(indiv_disp_3)-1)),
              list(`Season Percent` = color_bar("#FA614B"),
              `Season Percent`= improvement_formatter,
              `Adj Season Percent`= improvement_formatter)))
              
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```

```{r Plotting individual results over the season2, echo=FALSE, out.width = "100%"}
#Creating the individual plot.  
inst_indiv_plots = weekly_indiv_percent_plot %>% 
  ggplot(aes(x = factor(Week), y = Percent, color = Name))+
  geom_point()+
  geom_path(aes(x = as.factor(Week), y = Percent, color = Name, 
                group = Name))+
  ylim(c(0, 1)) +
  labs(x = "NFL Week", 
       y = "Correct Percentage", 
       title = "Weekly Individual Correct Percentage")+
  facet_wrap(~Name)+
  theme_classic()+
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 18),
        axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```

```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
```

```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week

#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>% 
  rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_options(
    data_row.padding = px(3)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.

For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
 
 </font>


#### ESPN

<font size="4">

We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
 
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.

</font>

Row
--------------------------------------

### Win percentage for the week

```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Season Win Percentage

```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```

### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```

### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```

Row
--------------------------------------

### 

```{r}
inst_group_table
```

### 

```{r}
ggplotly(inst_group_season_plot) %>% 
  layout(title = list(y = .93, xref = "plot"),
         margin = list(t = 40))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

### Individual Plots
```{r, out.width="100%"}
ggplotly(inst_indiv_plots)
```

### Season Leaderboard
```{r, out.width="100%"}
season_leaderboard
```

### Adjusted Season Leaderboard
```{r, out.width="100%"}
adj_season_leaderboard
```

Data
==========================================================================

```{r}
datatable(
  inst.data, extensions = 'Buttons', options = list(
    dom = 'Blfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
    lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
  )
)
```